home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 68.7z / BS1 part 68 / InterChange Plus v3.0 (1993-11)(Syndesis)(Disk 2 of 2).7z / InterChange Plus v3.0 (1993-11)(Syndesis)(Disk 2 of 2).adf / PC_Tools.LZH / ALISP.ZIP / CONVER.LSP < prev    next >
Lisp/Scheme  |  1993-10-06  |  3KB  |  95 lines
  1. ;CONVERT.LSP   WRITTEN BY PATRICK MCDONALD     4-4-91
  2. ;AUTOLISP STUDENT, BILLINGS VOCATIONAL TECHNICAL CENTER
  3. ;CONVERT.LSP WILL CONVERT ALL EXTRUDED LINES INTO 3DFACES.  IT WAS WRITTEN TO
  4. ;EASE THE TRANSITION OF DRAWINGS FROM ACAD TO 3D STUDIO AS 3D STUDIO DOES NOT
  5. ;RECOGNIZE EXTRUDED LINES.
  6. ;NOTE -- ALL LINES WILL BE EFFECTED EVEN IF ON FROZEN LAYERS.
  7. ;
  8. ;Your comments and suggestions are appreciated. Compuserve user# 76264,2273.
  9. (graphscr)
  10. (defun c:convert ()
  11.    (setvar "cmdecho" 0)
  12.    (initget "Yes No")
  13.    (setq qu (getkword "\nConvert polylines as well as lines <Y>/N? "))
  14.       (if (or (= qu "Yes") (= qu nil))
  15.           (c:plxplode)
  16.       )
  17.    (prompt "\nConverting extruded lines to 3dfaces...")
  18.    (prompt "\nWorking")
  19.    (command "ucs" "save" "cucs" "y")
  20.    (command "ucsicon" "off") 
  21.    (command "ucs" "world")
  22.    (setq clay (getvar "clayer"))
  23.    (setq numb 0)
  24.    (setq n (ssget "x" (list (cons 0 "LINE"))))
  25.    (if (= n nil) (setq n (ssadd)))
  26.    (setq m (ssget "x" (list (cons 0 "3dline"))))
  27.    (if (/= m nil)
  28.        (progn
  29.          (setq count 0)
  30.          (repeat (sslength m)
  31.          (setq n (ssadd (ssname m count) n))
  32.          (setq count (1+ count))
  33.          );repeat
  34.          );progn
  35.    );if
  36.    (setq count 0)
  37.    (if (/= (ssname n 0) nil)
  38.    (repeat (sslength n)
  39.        (princ ".")
  40.        (setq cent (entget (setq enm (ssname n count))))
  41.        (setq th (cdr (assoc 39 cent)))
  42.        (if (and (/= th 0) (/= th nil))
  43.            (progn
  44.            (setq numb (1+ numb))
  45.            (command "ucs" "zaxis" "0,0,0" (cdr (assoc 210 cent)))
  46.            (setq pt1 (cdr (assoc 10 cent)))
  47.            (setq pt2 (cdr (assoc 11 cent)))
  48.            (setq pt1 (trans pt1 0 1))
  49.            (setq pt2 (trans pt2 0 1))
  50.            (setq pt3 (list (car pt1) (cadr pt1) (+ (caddr pt1) th)))
  51.            (setq pt4 (list (car pt2) (cadr pt2) (+ (caddr pt2) th)))
  52.            (setq lsrch (tblsearch "layer" (cdr (assoc 8 cent))))
  53.            (if (= (cdr (assoc 70 lsrch)) 65)
  54.                (command "layer" "t" (cdr (assoc 8 cent)) "")
  55.                )
  56.            (command "layer" "s" (cdr (assoc 8 cent)) "")
  57.            (command "3dface" pt1 pt2 pt4 pt3 "")
  58.            (if (= (cdr (assoc 70 lsrch)) 65)
  59.                         (progn 
  60.                         (command "layer" "s" clay "")
  61.                         (command "layer" "f" (cdr (assoc 8 cent)) "")
  62.                         ))
  63.            (command "ucs" "world")
  64.            (command "erase" enm "")
  65.            );progn
  66.        );if
  67.   (setq count (1+ count))
  68. );repeat
  69. (prompt"\nNo lines found")
  70. )
  71. (command "redraw")
  72. (command "layer" "s" clay "")
  73. (command "ucs" "r" "cucs")
  74. (command "ucsicon" "on")
  75. (setvar "cmdecho" 1)
  76. (princ (strcat "\nDone " (rtos numb 2 0)" lines converted."))
  77. (princ)
  78. );defun
  79.  
  80. (defun c:plxplode ()
  81.    (setq count 0)
  82.    (setq ss (ssget "x" (list (cons 0 "POLYLINE"))))
  83.    (prompt "\nExploding polylines")
  84.    (if (= ss nil) (prompt"\nNo polylines found")
  85.    (repeat (sslength ss)
  86.       (command "explode" (ssname ss count))
  87.       (setq count (1+ count))
  88.    )
  89. )
  90. )
  91. (prompt "\n                        written by Pat McDonald")
  92. (prompt "\n              type 'CONVERT' to convert lines to 3dfaces")   
  93. (princ)
  94.  
  95.